home *** CD-ROM | disk | FTP | other *** search
/ Libris Britannia 4 / science library(b).zip / science library(b) / PROGRAMM / PASCAL / 0195.ZIP / EXTENDIO.PAS < prev    next >
Pascal/Delphi Source File  |  1984-12-17  |  2KB  |  76 lines
  1. {@@@@@@@@@@@ copyright (C) 1984 by Neil J. Rubenking @@@@@@@@@@@@@@@@@@@@@@@@
  2. The purchaser of these procedures and functions may include them in COMPILED
  3. programs freely, but may not sell or give away the source text.
  4. }
  5.  
  6. {$I filename.typ}
  7. {$I regpack.typ}
  8. {$I errmessg.lib}
  9. {$I extendio.lib}
  10.  
  11. label
  12.   crash;
  13. type
  14.   X_type = record
  15.              CH : char;
  16.              BT : byte;
  17.              ING : integer;
  18.            end;
  19. var
  20.   choice         : char;
  21.   The_Path       : filename_type;
  22.   handle, size   : integer;
  23.   X              : X_Type;
  24.   N, error_code  : byte;
  25.  
  26. {@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@}
  27. begin
  28.   WriteLn('Let''s create a file.  Enter a filename with full path.');
  29.   ReadLn(The_Path);
  30.   Xrewrite(The_Path,handle,error_code);
  31.   if error_code <> 0 then goto crash;
  32.       WriteLn(the_path,' has the handle ',handle);
  33.       WriteLn;
  34.       WriteLn('Now to write some data to the file.');
  35.       for N := 1 to 5 do
  36.         begin
  37.           with X do
  38.             begin
  39.               CH := chr(N + 64);
  40.               BT := N + 10;
  41.               ING := 400 - N;
  42.               WriteLn(CH,BT:5,ING:10);
  43.             end;
  44.           XWrite(handle,SizeOf(X),X,error_code);
  45.           if error_code <> 0 then goto crash;
  46.         end;
  47.       WriteLn('Just wrote five records');
  48.       WriteLn;
  49.       WriteLn('Now how big is that file?');
  50.       Xseek(handle,0,sizeOf(X),'E',size,error_code);
  51.       if error_code <> 0 then goto crash;
  52.       WRiteLn('It has ',size,' records of ',sizeOf(X),' bytes.');
  53.       XClose(handle,error_code);
  54.       if error_code <> 0 then goto crash;
  55.       WriteLn('Now I''l reset that file and read back those records.');
  56.       Xreset(The_Path,handle,error_code);
  57.       if error_code <> 0 then goto crash;
  58.       While error_code = 0 do
  59.         begin
  60.           Xread(handle,SizeOf(X),X,error_code);
  61.           if error_code = 0 then with X do
  62.             WriteLn(CH,'   ',BT,'   ',ING);
  63.         end;
  64.       Xclose(handle,error_code);
  65.       if error_code <> 0 then
  66.         writeLn('How can you get an error closing a file?!');
  67.       WriteLn('If you''ll let me, I''l erase the file I made.');
  68.       WriteLn('Can I? Please?');
  69.       read(choice);
  70.       if UpCase(choice) = 'Y' then
  71.         begin
  72.           XErase(The_Path,error_code);
  73.           if error_code <> 0 then goto crash;
  74.         end;
  75.   crash: if error_code <> 0 then WriteLn(message(error_code));
  76. end.